﻿<%
' 取[GET]方式的参数 ///
' ////////////////////////////////////////////////////////////
function getQueryString(str,def)
	dim Result,temp,tName
	Result=def:temp=""
	tName=TypeName(def)
	temp=Trim(Cstr(Request.QueryString(trim(str))))
	if temp<>"" then 			
		Result=temp
		if (tname="Integer" or tname="Double") and not IsNumeric(Result) then
		    'Response.Write "参数" & str & "必须为数字 <a href='javascript:window.history.back();'>返回</a>"
		    'Response.End
		    call AlertBack("参数" & str & "必须为数字")
		elseif tname="Date" and not isdate(Result) then
		    'Response.Write "参数" & str & "必须为日期 <a href='javascript:window.history.back();'>返回</a>"
		    'Response.End
		    call AlertBack("参数" & str & "必须为日期")
		end if
	end if	
	getQueryString=Cstr(Result)
end function
	
' 取[POST]方式的参数 //
' ////////////////////////////////////////////////////////////////
function getForm(str,def)
	dim Result,temp,tName
	Result=def:temp=""
	tName=TypeName(def)
	temp=Trim(Cstr(Request.Form(trim(str))))
	if temp<>"" then 			
		Result=temp
		if (tname="Integer" or tname="Double") and not IsNumeric(Result) then
		    'Response.Write "参数" & str & "必须为数字 <a href='javascript:window.history.back();'>返回</a>"
		    'Response.End
		    call AlertBack("参数" & str & "必须为数字")
		elseif tname="Date" and not isdate(Result) then
		    'Response.Write "参数" & str & "必须为日期 <a href='javascript:window.history.back();'>返回</a>"
		    'Response.End
		    call AlertBack("参数" & str & "必须为日期")
		end if
	end if	
	getForm=Cstr(Sql_filter(conFilterString,Result))
end function

' 防SQL注入 //
' ////////////////////////////////////////////////////////////////
function Sql_filter(str,val)
    dim tempArray
    tempArray=split(str,"|")
    for each t in tempArray
        if instr(val,t)>0 then
            Response.Write "系统提示: 参数中包含非法字符(" & t & ")！ <a href='javascript:window.history.back();'>返回</a>"
            Response.end()
        end if
    next
    Sql_filter=val
end function

%>
<% 
 ' 写脚本
 '//////////////////////////////////////////////////////////////////////////
 
' 执行Jscript
'*********************************
sub ExecScript(script)
    Response.Write("<script>" & script & "</s"&"cript>")
end sub

 ' 返回前一页
 '*********************************
sub HistoryBack
    ExecScript("window.history.back();")
    Response.End()
end sub

' 关闭页面
'*********************************
sub WebClose
    ExecScript("self.close();")
    Response.End()
end sub

' 跳转页
'*********************************
sub ToPage(page)
    ExecScript("window.location='" & page & "';")
    Response.End()
end sub

' 弹出信息,然后跳转
'*********************************
sub Alert(msg,page)
    'ExecScript("alert('" & msg & "');")
    'call ToPage(page)
    call alertPop(msg,page)
end sub

sub confirm(msg,page1,page2)
	
	Response.Clear
    dim result
    result=ReadTextFile(Server.MapPath("msg.htm"),"utf-8")
    
    result=replace(Result,"{$AppPath}",conSiteUrl)
    result=replace(Result,"{$msg}",msg)
	result=replace(Result,"{$img}","ico01.png")
	result=replace(Result,"{$rurl}","<button type=" & chr(34) & "button" & chr(34) & " onclick=" & chr(34) & "window.location='" & page1 & "'" & chr(34) & " >&nbsp;<img src=" & chr(34) & "" + conSiteUrl + "content/i/yes.gif" & chr(34) & " align=" & chr(34) & "absmiddle" & chr(34) & " />&nbsp;是&nbsp;&nbsp;</button>&nbsp;&nbsp;&nbsp;<button type=" & chr(34) & "button" & chr(34) & " onclick=" & chr(34) & "window.location='" & page2 & "'" & chr(34) & " >&nbsp;<img src=" & chr(34) & "" + conSiteUrl + "content/i/no.gif" & chr(34) & " align=" & chr(34) & "absmiddle" & chr(34) & " />&nbsp;否&nbsp;&nbsp;</button>")
    
    Response.Write(result)
    Response.End()
end sub

' 弹出信息,然后回到前一页
'*********************************
sub AlertBack(msg)
    'ExecScript("alert('" & msg & "');")
    'call HistoryBack
    call AlertPop(msg,"")
end sub

' 弹出信息,然后关闭当前页
'*********************************
sub AlertClose(msg)
    ExecScript("alert('" & msg & "');")
    call WebClose
    Response.End()
end sub

' 跳转信息页
'*********************************
sub AlertPop(msg,page1)
    Response.Clear
    dim result
    result=ReadTextFile(Server.MapPath("msg.htm"),"utf-8")
    
    result=replace(Result,"{$AppPath}",conSiteUrl)
    result=replace(Result,"{$msg}",msg)
    
    if page1<>"" then
        result=replace(Result,"{$img}","ico02.png")         
        result=replace(Result,"{$rurl}","<button onclick=" & chr(34) & "window.location='" & page1 & "'" & chr(34) & " id='gobtn'>自动跳转</button>")
        call Refresh(page1,2)
    else
        result=replace(Result,"{$img}","ico01.png") 
        result=replace(Result,"{$rurl}","<button id='backbtn'  onclick=" & chr(34) & "javascript:history.go(-1);" & chr(34) & " >返回上一页</button>")
    end if
    
    Response.Write(result)
    Response.End()
end sub

%>
<%
' 前台分页
' ***************************************
sub AbineShowPage(filePath,CurrentPage,MaxItemSize,TotalNumber,TotalPage) %>
<style type="text/css">
#PageerDiv{width: 100%; height: 23px; padding-top: 3px; text-align: center; }
#PageerDiv Table{ width:510px;border:0px;}
#PageerDiv Table td{ padding:4px 0px;text-align:center;}
#PageerDiv Table span{text-align:center;border:solid 1px #6595d7;padding:3px 4px 0px;background:AliceBlue;}
#PageerDiv Table .span1{background:AliceBlue;}
#PageerDiv Table .span2{background:#6595d7;color:white;}
</style>
<div id="PageerDiv"><table cellpadding="0" cellspacing="1"><tr><td height="25"><span style="background: #6595d7; color: White;padding-bottom:2px;"><b><%=TotalNumber %></b></span>&nbsp;<span style="background: #6595d7; color: White;padding-bottom:2px;"><b><%=CurrentPage %>/<%=TotalPage %></b></span>
<% if CurrentPage>1 then %><span><a href="<%=filePath%>PageNo=1">首页</a></span>&nbsp;<span><a href="<%=filePath%>PageNo=<%=(CurrentPage-1)%>">上页</a></span>
<% else %><span>首页</span>&nbsp;<span>上页</span>&nbsp;<% end if %>
            <% 
dim i,j
if (TotalPage - Int((CurrentPage-1)/10)*10) < 10 then 
    numberTotal=(TotalPage - Int((CurrentPage-1)/10)*10)
else
    numberTotal= 10 
end if
redim numberArray(numberTotal-1)
for i = 0 to ubound(numberArray)
    numberArray(i) = Int((CurrentPage-1)/10)*10 + i+1
next
 %>
            <% if numberTotal>0 then %>
            <% For Each j in numberArray%><% if j=CurrentPage then %><span onclick="window.location='<%=filePath %>PageNo=<%=j %>'" class="span2" style="cursor: pointer;padding-bottom:1px;"><%=j%></span>
<% else %><span onclick="window.location='<%=filePath %>PageNo=<%=j %>'" onmouseover="this.className='span2'"onmouseout="this.className='span1'" style="cursor: pointer; padding-bottom:3px;"><%=j%></span>
<% end if %><% next %><% end if %><% if CurrentPage<TotalPage then %><span><a href="<%=filePath%>PageNo=<%=(currentPage+1)%>">下页</a></span>
<span><a href="<%=filePath%>PageNo=<%=(TotalPage)%>">尾页</a></span>
<% else %><span>下页</span>&nbsp;<span>尾页</span><% end if %></td></tr></table>
</div>
<% End Sub %>
<%
' 前台分页EN
' ***************************************
sub AbineShowPageEn(filePath,CurrentPage,MaxItemSize,TotalNumber,TotalPage) %>
<style type="text/css">
#PageerDiv{width: 100%; height: 23px; padding-top: 3px; text-align: center; }
#PageerDiv Table{width: 500px; border:0px;}
#PageerDiv Table td{text-align: center;padding:2px 4px 0px;}
</style>
<div id="Div1">
<table cellpadding="0" cellspacing="1" width="100%"><tr><td ><b>Page:</b>
<% if CurrentPage>1 then %>
<a href="<%=filePath%>PageNo=<%=(CurrentPage-1)%>" class="TopA"><< Previous Page</a>&nbsp;&nbsp;
<% end if %>
            <% 
                dim i,j
                 if (TotalPage - Int((CurrentPage-1)/10)*10) < 10 then 
                    numberTotal=(TotalPage - Int((CurrentPage-1)/10)*10)
                 else
                    numberTotal= 10 
                 end if
                 redim numberArray(numberTotal-1)
                 for i = 0 to ubound(numberArray)
                    numberArray(i) = Int((CurrentPage-1)/10)*10 + i+1
                 next                               
            %>
            <% if numberTotal>0 then %>
            <% For Each j in numberArray%><a href="<%=filePath %>PageNo=<%=j %>" <%if j=currentpage then %> style="font-weight:bolder; color:Red;" <% end if %> class="TopA">[<%=j%>]</a>&nbsp;&nbsp;<% next %>
            <% end if %>
            <% if CurrentPage<TotalPage then %>
            <a href="<%=filePath%>PageNo=<%=(currentPage+1)%>" class="TopA">Next Page >></a>
            <% end if %></td></tr></table>
</div>
<% End Sub %>
<%
' 后台分页
' ***************************************
sub AbineShowPage2(filePath,CurrentPage,MaxItemSize,TotalNumber,TotalPage) %>
<div class="pageDiv"><table cellpadding="0" cellspacing="4" class="pageTable"><tr><td class="pageTableTd">共
<%=TotalNumber %>
条&nbsp;|&nbsp;每页
<%=MaxItemSize %>
条&nbsp;|&nbsp;
<% if CurrentPage>1 then %>
<a href="<%=filePath%>PageNo=1">首页</a>&nbsp;<a href="<%=filePath%>PageNo=<%=(CurrentPage-1)%>">上页</a>&nbsp;&nbsp;<% else %><a>首页</a>&nbsp;<a>上页</a>&nbsp;&nbsp;<% end if %><span><%=CurrentPage %> / <%=TotalPage %></span>&nbsp;&nbsp;<% if CurrentPage<TotalPage then %><a href="<%=filePath%>PageNo=<%=(currentPage+1)%>">下页</a>&nbsp;<a href="<%=filePath%>PageNo=<%=(TotalPage)%>">尾页</a>&nbsp;&nbsp;<% else %><a>下页</a>&nbsp;<a>尾页</a>&nbsp;&nbsp;<% end if %><input type="text" name="PageNo" id="PageNo" class="inputtext" value="<%=currentPage %>" style="width: 40px; height: 18px;" />&nbsp;<input type="button" value=" GO " class="inputBtn" style="height: 18px; padding-top: 0px;" onclick="window.location='<%=filePath %>pageno='+(Number(document.getElementById('PageNo').value))" /></td><td style="width: 20px; position: relative;">
                <% 
                dim i,j
                 if (TotalPage - Int((CurrentPage-1)/10)*10) < 10 then 
                    numberTotal=(TotalPage - Int((CurrentPage-1)/10)*10)
                 else
                    numberTotal= 10 
                 end if
                 redim numberArray(numberTotal-1)
                 for i = 0 to ubound(numberArray)
                    numberArray(i) = Int((CurrentPage-1)/10)*10 + i+1
                 next
                               
                %>
                <% if numberTotal>0 then %>
<img src="images/selectpage.gif" align="absmiddle" alt="选页" class="pageselectImg" onmouseover="pageSelect.style.display='block'" /><div class="pageselectDiv" id="pageSelect" onmouseout="this.style.display='none'" onmouseover="this.style.display='block'"><a <% if currentpage>10 then %> href="<%=filePath %>PageNo=<%=numberArray(0) - 10 %>" <% end if %>>10P<<</a>&nbsp;<% For Each j in numberArray%><a <% if currentpage=j then  %>style="color: #f00;" <% end if %> href="<%=filePath %>PageNo=<%=j %>">[<%=j%>]</a>&nbsp;<% next %><a <% if numberarray(numbertotal-1) < totalpage then %> href="<%=filePath %>PageNo=<%=numberArray(numberTotal-1) + 1 %>" <% end if %>>>>10P</a></div><% end if %></td></tr></table>
</div>
<% End Sub %>
<%
'**************************************************
'函数名：CurrentRecord
'作  用：计算当前页显示的记录数
'参  数：tempRs   ----数据集,AbsolutePage ----当前页
'返回值：记录数
'**************************************************
function CurrentRecord(tempRs,AbsolutePage)
    dim Result,RecordCount,PageSize,PageCount
    RecordCount=tempRs.RecordCount
    PageSize=tempRs.PageSize
    PageCount=tempRs.PageCount
    Result=PageSize
    if (TotalNumber mod PageSize)>0 and AbsolutePage=PageCount then
        Result= TotalNumber mod PageSize
    end if
    if TotalNumber=0 then Result=0
    CurrentRecord=Result
end function
%>
<% 
' Flash轮换图
sub FlashPicViewer(width,height,apics,alinks,atexts,IsShowBtn) %>
<script type="text/javascript">
var swf_width=<%=width %>
var swf_height=<%=height %>
var files='<%=apics %>'
var links='<%=alinks %>'
var texts='<%=atexts %>'
var IsShowBtn=<%=IsShowBtn %>

document.write('<object classid="clsid:d27cdb6e-ae6d-11cf-96b8-444553540000" codebase="http://fpdownload.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,0,0" width="'+ swf_width +'" height="'+ swf_height +'">');
document.write('<param name="movie" value="inc/bcastr.swf"><param name="quality" value="high">');
document.write('<param name="menu" value="false"><param name=wmode value="opaque">');
document.write('<param name="FlashVars" value="bcastr_file=' + files + '&bcastr_link=' + links + '&bcastr_title=' + texts + '&IsShowBtn=' + IsShowBtn + '">');
document.write('<embed src="inc/bcastr.swf" wmode="opaque" FlashVars="bcastr_file=' + files + '&bcastr_link=' + links + '&bcastr_title=' + texts + '&IsShowBtn=' + IsShowBtn + '" menu="false" quality="high" width="'+ swf_width +'" height="'+ swf_height +'" type="application/x-shockwave-flash" pluginspage="http://www.macromedia.com/go/getflashplayer" />'); document.write('</object>'); 
</script>
<% end sub%>
<%
'去掉HTML
'**************************************
function TrimHtml(arg0)
	Dim regEx
	Set regEx = New RegExp
	regEx.Pattern = "<.+?>"
	regEx.IgnoreCase = True
	regEx.Global = True
	TrimHtml = Replace(regEx.Replace(arg0,""),"&nbsp;","")
	Set regEx = Nothing
End function

'**************************************************
'函数名：CompressHtml
'作  用：压缩HTML,去掉空白
'参  数：html   ----原字符串
'返回值：压缩后
'**************************************************
function CompressHtml(html)
    Dim regEx
    set regEx = new RegExp
    regEx.Pattern="\s[^A-Za-z0-9_\042\/\w\}\#<>\+\%\u0391-\uFFE5]"
    regEx.IgnoreCase = true
    regEx.Global=true
    CompressHtml=regEx.Replace(html,"")
end function

'判断是否远程数据提交
'**************************************
function IsRemotePost()
    dim refhost,hhost
    hhost=lcase(Trim(Request.ServerVariables("HTTP_HOST")))
    refhost=replace(lcase(Trim(Request.ServerVariables("HTTP_REFERER"))),"http://","")
    if refhost<>"" and request.Form.Count>0 then
        if hhost<>mid(refhost,1,InStr(refhost,"/")-1) then
            IsRemotePost=true
        else
            IsRemotePost=false
        end if
    else
        IsRemotePost=false
    end if   
end function

'转换单双引号
'**************************************
function TurnSql(arg0)
	arg0=replace(arg0,"'","′")	
	arg0=replace(arg0,"@","＠")	
	TurnSql=arg0
End function


' textarea文本转换
' **************************************
function encode(str)
    If IsNull(str) Or Trim(str) = "" Then
        encode = ""
        Exit Function
    End If
    
    str = Replace(str, ">", "&gt;")
    str = Replace(str, "<", "&lt;")
    str = Replace(str, Chr(32), "&nbsp;")
    str = Replace(str, Chr(9), "&nbsp;")
    str = Replace(str, Chr(34), "&quot;")
    str = Replace(str, Chr(39), "&#39;")
    str = Replace(str, Chr(13), "")
    str = Replace(str, Chr(10), "<br />")
	encode=str
end function

function unencode(str)
    If IsNull(str) Or Trim(str) = "" Then
        unencode = ""
        Exit Function
    End If
    str = Replace(str, "&gt;", ">")
    str = Replace(str, "&lt;", "<")
    str = Replace(str, "&nbsp;", " ")
    str = Replace(str, "&quot;", Chr(34))
    str = Replace(str, "&#39;", Chr(39))
    str = Replace(str, "<br />", Chr(10))
	unencode=str
end function

'**************************************************
'函数名：cutLength
'作  用：截字符串，汉字一个算两个字符，英文算一个字符
'参  数：str   ----原字符串
'        strlen ----截取长度
'        bShowPoint ---- 结束符,如"…"
'返回值：截取后的字符串
'**************************************************
function cutLength(ByVal str, ByVal strlen, endstr)
    If IsNull(str) Or str = ""  Then
        GetSubStr = ""
        Exit Function
    End If
    Dim l, t, c, i, strTemp
    str = Replace(Replace(Replace(Replace(str, "&nbsp;", " "), "&quot;", Chr(34)), "&gt;", ">"), "&lt;", "<")
    l = Len(str)
    t = 0
    strTemp = str
    For i = 1 To l
        c = Abs(Asc(Mid(str, i, 1)))
        If c > 255 Then
            t = t + 2
        Else
            t = t + 1
        End If
        If t >= strlen Then
            strTemp = Left(str, i)
            Exit For
        End If
    Next
    str = Replace(Replace(Replace(Replace(str, " ", "&nbsp;"), Chr(34), "&quot;"), ">", "&gt;"), "<", "&lt;")
    strTemp = Replace(Replace(Replace(Replace(strTemp, " ", "&nbsp;"), Chr(34), "&quot;"), ">", "&gt;"), "<", "&lt;")
    If strTemp <> str And endstr<>"" Then
        strTemp = strTemp & endstr
    End If
    cutLength = strTemp
end function


'**************************************************
'函数名：GetRndPassword
'作  用：得到指定位数的随机数密码
'参  数：PasswordLen ---- 位数
'返回值：密码字符串
'**************************************************
function GetRndPassword(PasswordLen)
    Dim Ran, i, strPassword
    strPassword = ""
    For i = 1 To PasswordLen
        Randomize
        Ran = CInt(Rnd * 2)
        Randomize
        If Ran = 0 Then
            Ran = CInt(Rnd * 25) + 97
            strPassword = strPassword & UCase(Chr(Ran))
        ElseIf Ran = 1 Then
            Ran = CInt(Rnd * 9)
            strPassword = strPassword & Ran
        ElseIf Ran = 2 Then
            Ran = CInt(Rnd * 25) + 97
            strPassword = strPassword & Chr(Ran)
        End If
    Next
    GetRndPassword = strPassword
End function

'**************************************************
'函数名：GetRndNum
'作  用：产生制定位数的随机数
'参  数：iLength ---- 随即数的位数
'返回值：随机数
'**************************************************
Function GetRndNum(iLength)
    Dim i, str1
    For i = 1 To (iLength \ 5 + 1)
        Randomize
        str1 = str1 & CStr(CLng(Rnd * 90000) + 10000)
    Next
    GetRndNum = Left(str1, iLength)
End Function
' **************************************
%>
<%
 '***************************************************
'函数名：IsObjInstalled
'作  用：检查组件是否已经安装
'参  数：strClassString ----组件名
'返回值：True  ----已经安装
'       False ----没有安装
'***************************************************
function IsObjInstalled(strClassString)
	On Error Resume Next
	IsObjInstalled = False
	Err = 0
	Dim xTestObj
	Set xTestObj = Server.CreateObject(strClassString)
	If Err=0 Then IsObjInstalled = True
	Set xTestObj = Nothing
	Err = 0
End function

 '***************************************************
'函数名：getip
'作  用：获取IP
'返回值：IP地址 
'***************************************************
function getip()
    dim Result    
    Result = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
    if Result="" then
        Result = Request.ServerVariables("REMOTE_ADDR")
    end if
    getip=Result
end function


'***************************************************
'函数名：RegExpTest
'作  用：正则表表达式验证
'参  数：patrn ----正则表达式
'        strng ---- 验证的字符串
'返回值：True  ---- 配匹
'       False ---- 不配匹
'***************************************************
Function RegExpTest(patrn, strng) 
	Dim regEx, Result 	
	Set regEx = New RegExp 	
	regEx.Pattern = patrn 
	regEx.IgnoreCase = False 	
	Result = regEx.Test(strng) '
	RegExpTest = Result 
End Function 
 
'***************************************************
'函数名：Validator
'作  用：验证字符串是否属于特定格式
'参  数：types ---- 特定格式名
'       str ---- 验证的字符串
'返回值：True  ---- 配匹该类型
'       False ---- 不配匹该类型
' 例了 if not Validator("email",email) then response.write("不是Email")
'***************************************************
Function Validator(types,str)
	dim Result
	select case types
		case "email" Result=RegExpTest("^\w+([-+.]\w+)*@\w+([-.]\w+)*\.\w+([-.]\w+)*$",str)
		case "phone" Result=RegExpTest("^\+?\d+(\-\d+)?$",str)
		case "Url" Result=RegExpTest("^http:\/\/[A-Za-z0-9]+\.[A-Za-z0-9]+[\/=\?%\-&_~`@[\]\':+!]*([^<>\"\"])*$",str)
		case "chinese" Result=RegExpTest("^[\u0391-\uFFE5]+$",str)
		case "username" Result=RegExpTest("^[a-z]\w{3,14}$",str)
		case "password" Result=RegExpTest("^\S{5,20}$",str)
		case else Result=false
	end select
	Validator=Result
end function

'**************************************************
'函数名：FoundInArr
'作  用：检测数组中是否有指定的数值
'参  数：strArr ----- 调入的数组
'        strItem  ----- 检测的字符
'        strSplit  ----- 分割字符
'返回值：True  ----有
'        False ----没有
'**************************************************
Function FoundInArr(strArr, strItem, strSplit)
    Dim arrTemp, arrTemp2, i, j
    FoundInArr = False
    If IsNull(strArr) Or IsNull(strItem) Or Trim(strArr) = "" Or Trim(strItem) = "" Then
        Exit Function
    End If
    If IsNull(strSplit) Or strSplit = "" Then
        strSplit = ","
    End If
    If InStr(Trim(strArr), strSplit) > 0 Then
        If InStr(Trim(strItem), strSplit) > 0 Then
            arrTemp = Split(strArr, strSplit)
            arrTemp2 = Split(strItem, strSplit)
            For i = 0 To UBound(arrTemp)
                For j = 0 To UBound(arrTemp2)
                    If LCase(Trim(arrTemp2(j))) <> "" And LCase(Trim(arrTemp(i))) <> "" And LCase(Trim(arrTemp2(j))) = LCase(Trim(arrTemp(i))) Then
                        FoundInArr = True
                        Exit Function
                    End If
                Next
            Next
        Else
            arrTemp = Split(strArr, strSplit)
            For i = 0 To UBound(arrTemp)
                If LCase(Trim(arrTemp(i))) = LCase(Trim(strItem)) Then
                    FoundInArr = True
                    Exit Function
                End If
            Next
        End If
    Else
        If LCase(Trim(strArr)) = LCase(Trim(strItem)) Then
            FoundInArr = True
        End If
    End If
End Function

'**************************************************
'函数名：Jencode
'作  用：替换那26个片假名字符(效率很差目前没有用到)
'参  数：str ---- 要替换的字符
'        DatabaseType ---- 数据库类型
'返回值：替换后的字符
'**************************************************
Function Jencode(ByVal iStr)
    If IsNull(iStr) Or IsEmpty(iStr) Or iStr = "" Then
        Jencode = ""
        Exit Function
    End If
    Dim E, f, i
    E = Array("Jn0;", "Jn1;", "Jn2;", "Jn3;", "Jn4;", "Jn5;", "Jn6;", "Jn7;", "Jn8;", "Jn9;", "Jn10;", "Jn11;", "Jn12;", "Jn13;", "Jn14;", "Jn15;", "Jn16;", "Jn17;", "Jn18;", "Jn19;", "Jn20;", "Jn21;", "Jn22;", "Jn23;", "Jn24;", "Jn25;")
    f = Array(Chr(-23116), Chr(-23124), Chr(-23122), Chr(-23120), Chr(-23118), Chr(-23114), Chr(-23112), Chr(-23110), Chr(-23099), Chr(-23097), Chr(-23095), Chr(-23075), Chr(-23079), Chr(-23081), Chr(-23085), Chr(-23087), Chr(-23052), Chr(-23076), Chr(-23078), Chr(-23082), Chr(-23084), Chr(-23088), Chr(-23102), Chr(-23104), Chr(-23106), Chr(-23108))
    Jencode = iStr
    For i = 0 To 25
        Jencode = Replace(Jencode, f(i), E(i))
    Next
End Function

'**************************************************
'函数名：Juncode
'作  用：替换那26个片假名字符(效率很差目前没有用到)
'参  数：str ---- 要替换的字符
'        DatabaseType ---- 数据库类型
'返回值：替换后的字符
'**************************************************
Function Juncode(ByVal iStr)
    If IsNull(iStr) Or IsEmpty(iStr) Or iStr = "" Then
        Juncode = ""
        Exit Function
    End If
    Dim E, f, i
    E = Array("Jn0;", "Jn1;", "Jn2;", "Jn3;", "Jn4;", "Jn5;", "Jn6;", "Jn7;", "Jn8;", "Jn9;", "Jn10;", "Jn11;", "Jn12;", "Jn13;", "Jn14;", "Jn15;", "Jn16;", "Jn17;", "Jn18;", "Jn19;", "Jn20;", "Jn21;", "Jn22;", "Jn23;", "Jn24;", "Jn25;")
    f = Array(Chr(-23116), Chr(-23124), Chr(-23122), Chr(-23120), Chr(-23118), Chr(-23114), Chr(-23112), Chr(-23110), Chr(-23099), Chr(-23097), Chr(-23095), Chr(-23075), Chr(-23079), Chr(-23081), Chr(-23085), Chr(-23087), Chr(-23052), Chr(-23076), Chr(-23078), Chr(-23082), Chr(-23084), Chr(-23088), Chr(-23102), Chr(-23104), Chr(-23106), Chr(-23108))
    Juncode = iStr
    For i = 0 To 25
        Juncode = Replace(Juncode, E(i), f(i))
    Next
End Function

'***************************************************
'函数名：IsFileExists
'作  用：判断文件是否存在
'参  数：fullname ----文件完整名
'返回值：True  ----已经安装
'       False ----没有安装
'***************************************************
function IsFileExists(fullname)
	dim fso
	set fso=server.CreateObject("Scripting.FileSystemObject")
	if fso.FileExists(fullname) then
		IsFileExists=true
	else
		IsFileExists=false
	end if
	set fso=nothing
end function

 '***************************************************
'函数名：GenOrderNum
'作  用： 根据日期时间取订单号
'返回值： 订单号 
'***************************************************
function GenOrderNum()
    dim yy,mm,dd,riqi,xs,fz,miao,shijian
    
    '交易日期，格式：YYYYMMDD
    yy=right(year(date),2)
    mm=right("00"&month(date),2)
    dd=right("00"&day(date),2)
    riqi=yy & mm & dd

    '生成订单号所有所需元素,格式为：小时，分钟，秒
    xs=right("00"&hour(time),2)
    fz=right("00"&minute(time),2)
    miao=right("00"&second(time),2)
    shijian=xs & fz & miao
    
    GenOrderNum=riqi & shijian & GetRndNum(3)
end function
%>
<%
'***************************************************
'函数名称:GeneratedHtml
'作用:创建自身静态文件
'参数:isgen-是否生成,1-生成;CharSet-编码格式(utf-8,gb2312.....)
'***************************************************
function GeneratedHtml(isgen,Charset)     
    if isgen=1 then
        dim i,myurl,myfilename,querycount,htmlfilename,httppagebody,fso
        myurl="http://" & Request.ServerVariables("HTTP_HOST") & Request.ServerVariables("URL")  ' 动态页地址（不包含参数）
        
        ' 静页地址(如:newsdetail_1.htm) ----------------
        htmlfilename =  Request.ServerVariables("URL")
        htmlfilename= mid(htmlfilename,1,InStr(htmlfilename,".")-1)
        querycount=Request.QueryString.Count
        for i=1 to querycount            
            if Request.QueryString.Key(i)<>"gen" and Request.QueryString.Key(i)<>"rnd" then  '排除gen,
                htmlfilename = htmlfilename & "_" & Request.QueryString(i)
            end if
        next
        htmlfilename = htmlfilename & ".htm"        
        ' -------------------------------------------
        
        if request.QueryString("gen")="y" then
            httppagebody=getHTTPPage(myurl & "?" & Replace(Request.QueryString,"gen=y","gen=n"),Charset)
            call WriteTextFile(Server.MapPath(htmlfilename),httppagebody,Charset)
            Response.Redirect(htmlfilename)
            Response.End    
        elseif request.QueryString("gen")="" then
            set fso = CreateObject("Scripting.FileSystemObject")
            If (fso.FileExists(Server.MapPath(htmlfilename))) Then
                Response.Redirect(htmlfilename)
                Response.End 
            end if
            set fso=nothing   
        end if  
         
    end if   
end function


' 获取html页面源代码
'***************************************************
'函数名称:getHTTPPage
'作用:获取远程页面源代码(用于生成静态页和信息采集)
'参数:path: 页面地址(如:http://127.0.0.1/index.asp)
'     charset: 编码(如:gb2312 ,utf-8)
'***************************************************
function getHTTPPage(path,Charset)
    dim Http
    '---------------------
    Randomize()  '随机码,防止缓存
    if instr(path,"?")>0 then
        path = path & "&rnd=1" & rnd()
    else
        path = path & "?rnd=1" & rnd()
    end if
    
    '--------------------------------
    if not IsObjInstalled("MSXML2.XMLHTTP") then Exit Function
    set Http=Server.Createobject("MSXML2.XMLHTTP") 
    Http.open "GET",path,false 
    Http.send() 
    if Http.readystate<>4 then  
        exit function 
    end if 
    
    getHTTPPage=TurnCharset(Http.responseBody,Charset) 
    set http=nothing 
    if err.number<>0 then err.Clear  
end function

'***************************************************
'函数名称:TurnCharset
'作用:转换文本编码
'参数:body-文件内容;CharSet-编码格式(utf-8,gb2312.....)
'***************************************************
' 转换文本编码
function TurnCharset(body,CharSet) 
    dim Result,objstream 
    set objstream = Server.CreateObject("Adodb.Stream") 
    objstream.Type = 1 
    objstream.Mode =3 
    objstream.Open 
    objstream.Write body 
    objstream.Position = 0 
    objstream.Type = 2 
    objstream.Charset = CharSet 
    Result = objstream.ReadText()  
    objstream.Close
    set objstream = nothing 
    TurnCharset=Result
end function 



'***************************************************
'函数名称:ReadFile
'作用:利用AdoDb.Stream对象来读取CharSet编码的文本文件
'参数:filename-文件绝对路径;CharSet-编码格式(utf-8,gb2312.....)
'***************************************************
function ReadTextFile(filename,CharSet)
    dim Result,stm
    Result=""
    set stm=server.CreateObject("Adodb.Stream")
    stm.Type=2 '以本模式读取
    stm.Mode=3 
    stm.Charset=CharSet
    stm.Open()
    stm.loadfromfile filename
    Result=stm.ReadText()
    stm.Close
    set stm=nothing
    ReadTextFile=Result
end function

'***************************************************
'函数名称:WriteToFile
'作用:利用AdoDb.Stream对象来写入CharSet编码的文本文件
'参数:filename-文件绝对路径;Str-文件内容;CharSet-编码格式(utf-8,gb2312.....)
'***************************************************
function WriteTextFile(filename,byval Str,CharSet) 
    dim stm
    set stm=server.CreateObject("adodb.stream")
    stm.Type=2 '以本模式读取
    stm.Mode=3
    stm.Charset=CharSet
    stm.Open()
    stm.WriteText str
    stm.SaveToFile filename,2 
    stm.Flush()
    stm.Close()
    set stm=nothing
end function 

'**************************************************
'函数名：Refresh
'作  用：等待特定时间后跳转到指定的网址
'参  数：url ---- 跳转网址
'        refreshTime ---- 等待跳转时间
'**************************************************
Sub Refresh(url,refreshTime)
        Response.Write "<a Name='rsfreshurl' ID='rsfreshurl' href='"& url &"'></a>" & vbCrLf
        Response.Write "<script language=""javascript""> " & vbCrLf
        Response.Write "  function nextpage(){" & vbCrLf
        Response.Write "    var url = document.getElementById('rsfreshurl');" & vbCrLf
        Response.Write "    if (document.all) {" & vbCrLf
        Response.Write "      url.click();" & vbCrLf
        Response.Write "    }" & vbCrLf
        Response.Write "   else if (document.createEvent) {" & vbCrLf
        Response.Write "     var ev = document.createEvent('HTMLEvents');" & vbCrLf
        Response.Write "       ev.initEvent('click', false, true);" & vbCrLf
        Response.Write "       url.dispatchEvent(ev);" & vbCrLf
        Response.Write "    }" & vbCrLf
        Response.Write "  }" & vbCrLf
        Response.Write "  setTimeout(""nextpage();"","&refreshTime*1000&");" & vbCrLf
        Response.Write "</script>" & vbCrLf
End Sub

'***************************************************
'函数名:BinaryFile
'作  用:二进制输入文件,用于下载(隐藏下载地址及防盗代码)
'参  数:文件完整路径
'***************************************************
function BinaryFile(strFile)
    StrFilename=strFile
    Response.Buffer=true
    Response.Clear
    set S=Server.CreateObJect("ADODB.Stream")
    S.Open
    S.Type=1
    on error resume next
    set Fso=Server.CreateObJect("Scripting.FileSystemObject")
    if not Fso.FileExists(StrFilename) then
        From_Url=Cstr(Request.ServerVariables("HTTP_REFERER"))
        Serv_Url=Cstr(Request.ServerVariables("SERVER_NAME"))
        if mid(From_Url,8,len(Serv_Url)) <> Serv_Url then
            Response.WrIte "该文件不存在或者已经删除."
            Response.End
        end if
        Response.Redirect Request.ServerVariables("HTTP_REFERER")
        Response.End
    end if
    FileExt=mid(StrFilename,InStrRev(StrFilename, ".")+1)
    select case UCase(FileExt)
    case "ASP", "ASA", "ASPX", "ASAX", "MDB", "PHP", "JSP", "SHTML", "HTML", "HTM", "TV", "DATA"
        From_Url=cstr(Request.ServerVariables("HTTP_REFERER"))
        Serv_Url=cstr(Request.ServerVariables("SERVER_NAME"))
        if mid(From_Url,8,len(Serv_Url)) <> Serv_Url then
            Response.Write "该文件不存在或者已经删除."
            Response.End
        end if
        Response.Redirect Request.ServerVarIables("HTTP_REFERER")
        Response.End
    end select
    set F=Fso.GetFile(StrFilename)
    IntFilelength=F.Size
    s.LoadFromFile(StrFilename)
    if Err then
        From_Url=cstr(Request.ServerVarIables("HTTP_REFERER"))
        Serv_Url=cstr(Request.ServerVarIables("SERVER_NAME"))
        if MId(From_Url,8,len(Serv_Url)) <> Serv_Url then
            Response.WrIte "该文件数据不完整或许已损坏."
            Response.End
        end if
        Response.RedIrect Request.ServerVarIables("HTTP_REFERER")
        Response.End
    end if
    set Upload=Server.CreateObJect("Persits.Upload")
    if Upload is nothing then
        Response.AddHeader "Content-Disposition","attachment; Filename=" & F.Name
        Response.AddHeader "Content-Length",IntFilelength
        Response.CharSet="UTF-8"
        Response.ContentType="application/x-download"
        Response.BinaryWrite s.Read
        Response.Flush
        s.Close
        set s=nothing
    else
        Upload.SendBinary StrFilename,true,"application/x-download",false
    end If
end function
%>
<%
'***************************************************
'函数名称:ShortDate
'作用:日期格式转换,如1982-4-2 12:30:1 转成  1982-04-02
'参数:日期
'***************************************************
function ShortDate(idate)
    if IsDate(idate) then
        dim iyear,imonth,iday
        iyear=year(idate)
        imonth=month(idate)
        iday=day(idate)
        if len(imonth) <> 2 then imonth="0" & imonth
        if len(iday) <> 2 then iday="0" & iday
        ShortDate=iyear & "-" & imonth & "-" & iday
    else
        ShortDate=idate
    end if
end function
%>
<%
'***************************************************
'函数名称:GetOrderStatus
'作用:会员看状态图
'参数:日期
'***************************************************
function GetOrderStatus(arg0)
	dim result
	Select Case arg0
		case 0 result="<span style='color:dimgray;'>无效</span>"
		case 1 result="<span style='color:red;'>等待客服处理</span>"
		case 2 result="<span style='color:darkmagenta;'>有效等待支付</span>"
		case 3 result="<span style='color:cadetblue;'>有效正在配货</span>"
		case 4 result="<span style='color:darkorange;'>已发货</span>"
		case 6 result="<span style='color:indigo;'>退货</span>"
		Case Else result="<span style='color:green;'>完成</span>"
	End Select
	GetOrderStatus=result
end function
%>